home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / toolkit / vertmenu.prg < prev    next >
Text File  |  1991-08-15  |  6KB  |  186 lines
  1. /*
  2.  * File......: VERTMENU.PRG
  3.  * Author....: Greg Lief
  4.  * CIS ID....: 72460,1760
  5.  * Date......: $Date:   15 Aug 1991 23:04:48  $
  6.  * Revision..: $Revision:   1.1  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/vertmenu.prv  $
  8.  *
  9.  * This function is an original work by Mr. Grump and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/vertmenu.prv  $
  16.  * 
  17.  *    Rev 1.1   15 Aug 1991 23:04:48   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.0   01 Apr 1991 01:02:26   GLENN
  21.  * Nanforum Toolkit
  22.  *
  23.  */
  24.  
  25. /*  $DOC$
  26.  *  $FUNCNAME$
  27.  *     FT_MENU2()
  28.  *  $CATEGORY$
  29.  *     Menus/Prompts
  30.  *  $ONELINER$
  31.  *     Vertical lightbar menu
  32.  *  $SYNTAX$
  33.  *     FT_MENU2( <aMenuarray> [, <cColors> ] ) -> NIL
  34.  *  $ARGUMENTS$
  35.  *     <aMenuarray> is an array of menu options, messages, and action
  36.  *      blocks.
  37.  *
  38.  *     Each element in this array is a nested array with the structure:
  39.  *
  40.  *        element[x, 1] = menu option
  41.  *        element[x, 2] = message to be displayed when option is highlighted
  42.  *        element[x, 3] = code block to be executed when option is selected
  43.  *
  44.  *     <cColors> is a string containing colors for the prompts, in the same
  45.  *     format as that returned by Set( _SET_COLOR ).  If not supplied,
  46.  *     colors default to the current color setting.
  47.  *  $RETURNS$
  48.  *     NIL
  49.  *  $DESCRIPTION$
  50.  *     This function greatly simplifies the process of displaying light-bar
  51.  *     menus.  All prompts are padded out with spaces so they are the same
  52.  *     length, a box is drawn around the prompts, the box is automatically
  53.  *     centered on the screen, and the underlying screen is restored after
  54.  *     a menu selection has been made.
  55.  *
  56.  *     Additionally, because you can tie action blocks to each menu
  57.  *     option, you can save on a lot of DO CASE or IF..ELSEIF code in your
  58.  *     main program.  See the test code for a succinct demonstration.
  59.  *  $EXAMPLES$
  60.  *      LOCAL mainmenu := ;
  61.  *          { { "Data Entry", "Enter data",   { || FT_MENU2(datamenu)  } }, ;
  62.  *            { "Reports",    "Hard copy",    { || FT_MENU2(repmenu)   } }, ;
  63.  *            { "Maintenance","Reindex files",{ || FT_MENU2(maintmenu) } }, ;
  64.  *            { "Quit", "See ya later" } }
  65.  *      FT_MENU2(mainmenu)
  66.  *  $END$
  67.  */
  68.  
  69. #include "box.ch"
  70.  
  71. // test code
  72. #ifdef FT_TEST
  73.  
  74. FUNCTION MAIN
  75. LOCAL MAINMENU := ;
  76.     { { "DATA ENTRY", "ENTER DATA",         { || FT_MENU2(datamenu)  } }, ;
  77.       { "Reports",    "Hard copy",          { || FT_MENU2(repmenu)   } }, ;
  78.       { "Maintenance","Reindex files, etc.",{ || FT_MENU2(maintmenu) } }, ;
  79.       { "Quit", "See ya later" } }
  80.  
  81. local datamenu := { { "Customers", , { || cust() } }   , ;
  82.                     { "Invoices",  , { || inv() } }    , ;
  83.                     { "Vendors",   , { || vendors() } }, ;
  84.                     { "Exit", "Return to Main Menu" } }
  85.  
  86. local repmenu :=  { { "Customer List", , { || custrep() } }  , ;
  87.                     { "Past Due",      , { || pastdue() } }  , ;
  88.                     { "Weekly Sales",  , { || weeksales() } }, ;
  89.                     { "Monthly P&L",   , { || monthpl() } }  , ;
  90.                     { "Vendor List",   , { || vendorrep() } }, ;
  91.                     { "Exit", "Return to Main Menu" } }
  92.  
  93. local maintmenu := { { "Reindex",  "Rebuild index files", { || re_ntx() } } , ;
  94.                      { "Backup",   "Backup data files"  , { || backup() } } , ;
  95.                      { "Compress", "Compress data files", { || compress()} }, ;
  96.                      { "Exit", "Return to Main Menu" } }
  97.  
  98. FT_MENU2(mainmenu)
  99. return nil
  100.  
  101. /* stub functions to avoid missing symbols */
  102. static function cust
  103. static function inv
  104. static function vendors
  105. static function custrep
  106. static function pastdue
  107. static function weeksales
  108. static function monthpl
  109. static function vendorrep
  110. static function re_ntx
  111. static function backup
  112. static function compress
  113.  
  114. #endif
  115.  
  116. /*
  117.    FT_MENU2(): display vertical menu
  118. */
  119.  
  120. FUNCTION ft_menu2( aMenuInfo, cColors )
  121.  
  122. LOCAL nChoice     := 1                       ,;
  123.       nOptions    := Len( aMenuInfo )        ,;
  124.       nMaxwidth   := 0                       ,;
  125.       nLeft                                  ,;
  126.       x                                      ,;
  127.       cOldscreen                             ,;
  128.       nTop                                   ,;
  129.       lOldwrap    := Set( _SET_WRAP, .T. )   ,;
  130.       lOldcenter  := Set( _SET_MCENTER, .T. ),;
  131.       lOldmessrow := Set( _SET_MESSAGE )     ,;
  132.       cOldcolor   := Set( _SET_COLOR )
  133.  
  134. IF cColors # NIL
  135.    Set( _SET_COLOR, cColors )
  136. ENDIF
  137.  
  138. /* if no message row has been established, use bottom row */
  139. IF lOldmessrow == 0
  140.    Set( _SET_MESSAGE, Maxrow() )
  141. ENDIF
  142.  
  143. /* determine longest menu option */
  144. Aeval( aMenuInfo, { | ele | nMaxwidth := max( nMaxwidth, len( ele[1] ) ) } )
  145.  
  146. /* establish top and left box coordinates */
  147. nLeft := ( ( Maxcol() + 1 ) - nMaxwidth ) / 2
  148. nTop  := ( ( Maxrow() + 1 ) - ( nOptions + 2 ) ) / 2
  149.  
  150. DO WHILE nChoice != 0 .AND. nChoice != nOptions
  151.  
  152.    cOldscreen := Savescreen( nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth )
  153.  
  154.  
  155.    @ nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth BOX B_SINGLE + ' '
  156.    Devpos( nTop, nLeft )
  157.    FOR x := 1 to Len( aMenuInfo )
  158.       IF Len( aMenuInfo[x] ) > 1 .AND. aMenuInfo[x,2] != NIL
  159.          @ Row() + 1, nLeft PROMPT Padr( aMenuInfo[x, 1], nMaxwidth ) ;
  160.                             MESSAGE aMenuInfo[x,2]
  161.       ELSE
  162.          @ Row() + 1, nLeft PROMPT Padr( aMenuInfo[x,1], nMaxwidth )
  163.       ENDIF
  164.    NEXT
  165.  
  166.    MENU TO nChoice
  167.  
  168.    Restscreen( nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth, cOldscreen )
  169.  
  170.    /* execute action block attached to this option if there is one */
  171.    IF nChoice > 0 .AND. Len(  aMenuInfo[ nChoice ]  ) == 3
  172.       Eval(  aMenuInfo[nChoice,3]  )
  173.    ENDIF
  174.  
  175. ENDDO
  176.  
  177. /* restore previous message and wrap settings */
  178. Set( _SET_MESSAGE, lOldmessrow )
  179. Set( _SET_MCENTER, lOldcenter )
  180. Set( _SET_WRAP,    lOldwrap )
  181. Set( _SET_COLOR,   cOldcolor )
  182.  
  183. RETURN NIL
  184.  
  185. * end of file: vertmenu.prg
  186.